Loadstar 131/131.d81/menubox source

Text File | 2022-08-26 | 21KB | 1,957 lines

open =$ffc0
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
load =$ffd5
getin =$ffe4
clrchn =$ffcc
close =$ffc3   ;a
chrin =$ffcf
chkout =$ffc9  ;x
chkin =$ffc6   ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903
background =53281
border =53280
unlisten =$ffae
clall =$ffe7
home =19
buffer =$200

crsr'down =17
crsr'right =29
crsr'up =145
insert =148
crsr'left =157
temp =247
index =249
offset =167
item =169
.org $9000
;mem
.obj "@0:menubox 9000"

jmp pattern1
jmp box'entry;3
jmp frame'entry;6
jmp copy'tile;9
jmp get'address;12
jmp ml'pattern1;15
jmp ml'box'entry;18
jmp ml'frame;21
jmp ml'copy'tile;24
jmp get'file;27
jmp scroll'up;30
jmp scroll'down;33
jmp clear'row;36
jmp set'location;39
jmp fill'array ;42   string,index,on/off
jmp index'array;45
jmp rack'it'up;48
jmp find'clear;51
jmp bload'dir;54
jmp regular'menu;57
jmp dir'menu;60
jmp set'dir'mode;63
jmp getword;66

get'address ldx <more'tiles
ldy >more'tiles
stx 781
sty 782
rts

ml'pattern1 stx $14
sty $15

ldy #7
- lda ($14),y
sta parms,y
dey
bpl -
jmp pt1

ml'box'entry stx $14
sty $15

ldy #5
- lda ($14),y
sta parms,y
dey
bpl -
jmp fill'box

ml'frame stx $14
sty $15

ldy #4
- lda ($14),y
sta parms,y
dey
bpl -
jmp frame'up

ml'copy'tile stx $14
sty $15

ldy #5
lda #0
- sta parms,y
dey
bpl -
ldy #0
lda ($14),y
sta parms+4
iny
lda ($14),y
sta parms+5
iny
lda ($14),y
sta parms
iny
lda ($14),y
sta parms+2
jmp tile'math

pattern1 lda #0;x1,x2,y1,y2,t1,t2,c1,c2
;                +0 +1 +2 +3 +4 +5 +6 +7
sta 212
sta toggle
jsr linx
- jsr get'number
ldx toggle
tya
sta parms,x
inc toggle
lda toggle
cmp #8
bcc -

pt1 lda parms+2
sta 214
jsr 58732
jsr old'rom'patch
- lda 214
and #1
sta toggle

ldy parms
- ldx toggle
lda parms+4,x
sta (209),y
lda parms+6,x
sta (243),y
inc toggle
lda toggle
and #1
sta toggle
iny
cpy parms+1
bcc -
beq -

jsr line'math
lda 214
cmp parms+3
bcc --
beq --
lda #19
jmp chrout

get'number jsr $aefd
jsr $ad8a
jmp $b7f7

linx ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -
rts

box'entry lda #0
sta temp
- jsr get'number
tya
ldx temp
sta parms,x
inc temp
cpx #5
bne -

fill'box jsr linx
lda 214
pha
lda 211
pha
box'start ldx parms+2
ldy #0
clc
jsr $fff0
jsr old'rom'patch
dec parms

- ldy parms+1
- lda parms+4
cmp #255
beq +
sta (209),y
+ lda parms+5
sta (243),y
dey
cpy parms
bne -
lda 214
cmp parms+3
beq +

jsr line'math
jmp --
+ lda #home
jsr $ffd2
pla
sta 211
pla
sta 214
jmp 58732

frame'up jsr linx
lda 214
pha
lda 211
pha
frame'start ldx box'parameters+2
ldy #0
clc
jsr plot
jsr old'rom'patch
;dec box'parameters

ldy box'parameters+1
lda box'parameters+4
pha
and #128
ora #110
sta (209),y
pla
sta (243),y
dey

- lda box'parameters+4
pha
and #128
ora #64
sta (209),y
pla
sta (243),y
dey
cpy box'parameters
bne -

lda box'parameters+4
pha
and #128
ora #112
sta (209),y
pla
sta (243),y

- jsr line'math

lda 214
cmp box'parameters+3
bcs do'bottom

lda box'parameters+4
pha
and #128
ora #93
ldy box'parameters
sta (209),y
ldy box'parameters+1
sta (209),y
pla
sta (243),y
ldy box'parameters
sta (243),y
jmp -

do'bottom ldy box'parameters+1
lda box'parameters+4
pha
and #128
ora #125
sta (209),y
pla
sta (243),y
dey

- lda box'parameters+4
pha
and #128
ora #64
sta (209),y
pla
sta (243),y
dey
cpy box'parameters
bne -

lda box'parameters+4
pha
and #128
ora #109
sta (209),y
pla
sta (243),y

pla
sta 211
pla
sta 214
jsr 58732
jmp linx

line'math inc 214
lda #40
clc
adc 209
sta 209
lda #0
adc 210
sta 210
lda #40
clc
adc 243
sta 243
lda #0
adc 244
sta 244
rts

frame'entry jsr get'number
sty parms
jsr get'number
sty parms+1
jsr get'number
sty parms+2
jsr get'number
sty parms+3
jsr get'number
sty parms+4
ldx <parms
ldy >parms
jmp frame'up

copy'tile jsr get'number
sty parms+4
sta parms+5
jsr get'number
sty parms
jsr get'number
sty parms+2
lda #0
sta parms+1
sta parms+3

tile'math ldy #2
- asl parms
rol parms+1
dey
bpl -
ldy #2
- asl parms+2
rol parms+3
dey
bpl -

lda parms+4
clc
adc parms+2
sta stash'it+1
lda parms+5
adc parms+3
sta stash'it+2

lda parms
clc
adc <tiles
sta copy'pattern+1
lda parms+1
adc >tiles
sta copy'pattern+2
jsr rom'out

ldy #7
copy'pattern lda pattern,y
stash'it sta $c000,y
dey
bpl copy'pattern
jmp rom'in


;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3
ldx $22
ldy $23
rts

locvar lda $7a
pha
lda $7b
pha
stx $7a
sty $7b
jsr $b08b
sta $49
sty $4a
pla
sta $7b
pla
sta $7a
rts

set'string sta $64
sty $65
jmp $aa52

clear'buffer ldy #79
lda #0
- sta buffer,y
dey
bpl -
rts

get'dimensions jsr get'number
sty startingx
jsr get'number
sty endingx
jsr get'number
sty startingy
jsr get'number
sty endingy
rts

scroll'up jsr get'dimensions
ml'scroll'up ldy startingx
ldx startingy
stx line
clc
jsr plot
jsr old'rom'patch

scroll'up'math clc
lda 209
adc <40
sta 251
lda 210
adc >40
sta 252

clc
lda 243
adc <40
sta 253
lda 244
adc >40
sta 254

ldy startingx

- lda (251),y
sta (209),y
lda (253),y
sta (243),y
iny
cpy endingx
beq -
bcc -

inc line
lda line
cmp endingy
bcs through'scrolling'up

clc
lda 209
adc <40
sta 209
lda 210
adc >40
sta 210

clc
lda 243
adc <40
sta 243
lda 244
adc >40
sta 244
jmp scroll'up'math

through'scrolling'up ldx endingy
ldy startingx
clc
jmp plot
jsr old'rom'patch

scroll'down jsr get'dimensions
ml'scroll'down ldy startingx
ldx endingy
stx line
clc
jsr plot
jsr old'rom'patch

scroll'down'math sec
lda 209
sbc <40
sta 251
lda 210
sbc >40
sta 252

sec
lda 243
sbc <40
sta 253
lda 244
sbc >40
sta 254

ldy startingx

- lda (251),y
sta (209),y
lda (253),y
sta (243),y
iny
cpy endingx
beq -
bcc -

dec line
lda line
cmp startingy
beq through'scrolling'down

sec
lda 209
sbc <40
sta 209
lda 210
sbc >40
sta 210

sec
lda 243
sbc <40
sta 243
lda 244
sbc >40
sta 244
jmp scroll'down'math

through'scrolling'down ldx startingy
ldy startingx
clc
jsr plot
jmp old'rom'patch

clear'row jsr get'number
sta char
jsr get'number
sta color

ml'clear ldy startingx
- lda char
sta (209),y
lda color
sta (243),y
iny
cpy endingx
beq -
bcc -
rts

old'rom'patch lda 210
sec
sbc 648
clc
adc #$d8
sta 244
lda 209
sta 243
rts

fill'array jsr get'string
stx location
sty location+1
sta length
jsr get'number
sty index
sta index+1
jsr get'number
sty selected

write'table jsr index'math

jsr rom'out
ldy #3
- lda location,y
sta (251),y
dey
bpl -

jmp rom'in

index'array lda #0
sta offset
sta offset+1
sta item
jsr get'number
sty index
sta index+1
lda dir'mode
beq read'table
lda index
sta offset
lda index+1
sta offset+1
lda #0
sta index
sta index+1
jmp make'filename

read'table jsr index'math

jsr rom'out
ldy #3
- lda (251),y
sta location,y
dey
bpl -

jsr rom'in

lda selected
sta 253
lda #0
sta 254
jmp make'variable

index'math lda index
sta 253
lda index+1
sta 254

asl 253
rol 254
asl 253
rol 254

clc
lda array'storage
adc 253
sta 251
lda array'storage+1
adc 254
sta 252
rts

rom'out pha
lda #$74
sei
sta 1
pla
rts

rom'in pha
lda #$77
sta 1
pla
cli
rts


;store lsb in 253
;store msb in 254
;makes varible, f%

make'variable lda "f"
sta 251
lda "%"
sta 252

lda $7a
pha
lda $7b
pha

lda <251
sta $7a
lda >251
sta $7b
jsr $b08b
ldy #0
lda 254 ;high byte
sta ($47),y
iny
lda 253 ;low byte
sta ($47),y
pla
sta $7b
pla
sta $7a
rts

find'clear rts

load'index lda parms
sta index
lda parms+1
sta index+1
rts

bload'dir jsr get'string
jsr setnam
jsr get'number
sty device
tya
tax
lda #1
ldy #0
jsr setlfs
jsr get'number
ldx $14
ldy $15
stx dir'location
stx 174
sty dir'location+1
sty 175
lda #0
jsr open
jsr clrchn
ldx #1
jsr chkin
jsr getin
jsr getin

ldy #0
- jsr getin
jsr rom'out
sta (174),y
jsr rom'in
inc 174
bne +
inc 175
+ jsr readst
and #66
beq -
lda #1
jsr close
jsr clrchn

lda 174
sec
sbc dir'location
sta files
lda 175
sbc dir'location+1
sta files+1

ldy #4
- lsr files+1
ror files
dey
bpl -

lda files
sec
sbc #2
sta files
sta 253
lda files+1
sbc #0
sta files+1
sta 254
jsr make'variable
lda dir'location
clc
adc #32
sta dir'location
lda dir'location+1
adc #0
sta dir'location+1
rts

set'location jsr get'number
mlset sty array'storage
sta array'storage+1
rts

;sys rm,x1,x2,y1,y2,rvs,text,highlight,
;selected,offset,limit,multimode
regular'menu lda #0
sta dir'mode
jsr get'number
sty menux1
sty error'string
sty startingx
jsr get'number
sty